home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / database / tickle15.zip / TKL.PPS < prev    next >
Text File  |  1996-08-02  |  41KB  |  1,468 lines
  1. '
  2. '  Declare our variables
  3. '
  4.  
  5. STRING dbfields(49), file_name, pcbtext_number, main_prompt, key
  6. STRING user_input, pcb_user_name, field_name, next_file_entry
  7. STRING hold, hold2, flag_files(24), desc_hold, flag_list, temp
  8. STRING user_input2, stack_var, temp_var, dlpath_lst, first_letter
  9. STRING ndx_file_name, dlpath_lst_entry, file_root, file_ext, bank_path
  10. STRING tkltext, reg_code, user_input3, cname_file, tkl_cfg, passed_name
  11. STRING capture_file, qwk_file, cfg_sl
  12.  
  13. INT cmd_line_count, filenames_used, next_flag_file, bank_time
  14. INT count, x, i, hold_num, start, end, letter_value
  15. INT alpha, temp_int, index_start, index_end, current_record
  16. INT low_record, high_record, y, cname_size, temptime
  17.  
  18. STRING last_date               ' Last date user used Bank
  19. STRING wd_byte_date            ' Last date of bytes w/d
  20. STRING wd_time_date            ' Last date of time w/d
  21. STRING max_dl_bytes            ' Password file D/L Byte Limit
  22.  
  23. INTEGER byte_wd                ' bytes withdrawn for day
  24. INTEGER max_byte_wd            ' Max bytes user can w/d per day (CFG)
  25. INTEGER bank_bytes             ' Current Bank Bytes
  26. INTEGER max_bank_bytes         ' Maximum bytes to deposit   (CFG)
  27. INTEGER size                   ' Generic INTEGER variable
  28. INTEGER tempbytes              ' Generic INTEGER variable
  29.  
  30. INTEGER time_wd                    ' time withdrawn for day
  31. INT max_time_wd                ' Max time user can w/d per day (CFG)
  32. INT max_bank_time              ' Maximum time allowed to deposit    (CFG)
  33.  
  34. LONG file_size, ndx_size, seek_record, value
  35. FLOAT high_num, low_num, rec_num
  36.  
  37. BOOLEAN menu_displayed, did_list, did_delete, did_reorg
  38. BOOLEAN start_flag, did_flag, did_help, edit_description
  39. BOOLEAN do_menu, file_exists, cfg_file_exist, name_found
  40. BOOLEAN done, registered, use_bank, file_dupe, used_bank
  41.  
  42. DECLARE PROCEDURE WAIT_FOR_KEY()
  43.  
  44. *$USEFUNCS
  45.  
  46. BEGIN
  47.  
  48.    IF (file_name = "" || file_name = "MENU") do_menu = TRUE
  49.    hold = PPEPATH() + LTRIM(STRING(PCBNODE())," ") + ".FLG"
  50.    IF (EXIST(hold)) DELETE hold
  51.    next_flag_file = 1
  52.  
  53.    '
  54.    '  Process the command line
  55.    '  if first file processed  and it exceeds a ratio,
  56.    '  then do not even prompt for addition to the database.
  57.    '
  58.    '  ****
  59.    '  Might want to add a configuration file or something
  60.    '  that allows this by security level & number of bytes
  61.    '  ****
  62.    '
  63.    GOSUB PROCESS_COMMAND_LINE
  64.  
  65.    '
  66.    '  Set external text filename to a variable
  67.    '
  68.    tkltext = PPEPATH() + "TKLTEXT" + LANGEXT()
  69.  
  70.    '  Open the database file and the index.
  71.    '
  72.    GOSUB OPEN_DATABASE
  73.    IF (DERR(0)) THEN
  74.      NEWLINE
  75.      PRINTLN READLINE (tkltext,2)
  76.      NEWLINE
  77.      PRINTLN READLINE (tkltext,3)
  78.      NEWLINE
  79.      LOG "Cannot open TICKLE.DBF (DataBase) - Aborting", FALSE
  80.      WAIT
  81.      GOTO EXIT_PROG
  82.    END IF
  83.  
  84.    GOSUB OPEN_INDEX
  85.    IF (DERR(0)) THEN
  86.      NEWLINE
  87.      PRINTLN READLINE (tkltext,4)
  88.      NEWLINE
  89.      PRINTLN READLINE (tkltext,3)
  90.      NEWLINE
  91.      LOG "Cannot open TICKLE.NDX (Index) - Aborting", FALSE
  92.      WAIT
  93.      GOTO EXIT_PROG
  94.    END IF
  95.  
  96.    GOSUB FIND_ADD_USER
  97.    GOSUB READ_CFG
  98.    IF (pcbtext_number = "")  LOG "'Tickle File' entered by user", FALSE
  99.    IF (file_name = "MENU" || pcbtext_number != "") GOSUB MENU
  100.  
  101.    '
  102.    '  Exit the program
  103.    '
  104.    GOTO EXIT_PROG
  105.  
  106. END
  107. '
  108. '====================================
  109. '|                                  |
  110. '|  Subroutines used in SAVFIL.PPE  |
  111. '|                                  |
  112. '====================================
  113. '
  114. '
  115. '
  116. :CHECK_NUMBER_RANGE
  117.  
  118.    user_input = REPLACESTR(user_input, ",", " ")
  119.    IF (INSTR(user_input,"-") = 0 || INSTR(user_input,"-") = 1) RETURN
  120.    stack_var = user_input
  121.    user_input = ""
  122.    TOKENIZE stack_var
  123.    IF (TOKCOUNT() = 0) RETURN
  124.    FOR hold_num = 1 TO LEN(stack_var)
  125.      temp_var = GETTOKEN()
  126.      IF (temp_var = "") BREAK
  127.      IF (INSTR(temp_var, "-") = 0) THEN
  128.        user_input = user_input + temp_var + " "
  129.      ELSE
  130.        hold = MID(temp_var, 1, INSTR(temp_var,"-")-1)
  131.        IF (hold != "") hold2 = MID(temp_var, INSTR(temp_var,"-")+1, LEN(temp_var))
  132.        start = S2I(hold,10)
  133.        end = S2I(hold2,10)
  134.        IF (start < 1) THEN
  135.          IF (start = 0) hold = temp_var
  136.          NEWLINE
  137.          PRINTLN READLINE (tkltext,26), hold, READLINE (tkltext,27)
  138.          NEWLINE
  139.          CONTINUE
  140.        END IF
  141.        IF (end > 24) THEN
  142.          NEWLINE
  143.          PRINTLN READLINE (tkltext,26), end, READLINE (tkltext,27)
  144.          NEWLINE
  145.          CONTINUE
  146.        END IF
  147.        IF (end >= start) THEN
  148.          FOR count = start TO end
  149.            user_input = user_input + LTRIM(I2S(count,10)," ") + " "
  150.          NEXT
  151.        ELSE
  152.          NEWLINE
  153.          PRINTLN READLINE (tkltext,5), temp_var, READLINE (tkltext,6)
  154.        END IF
  155.      END IF
  156.    NEXT
  157.    RETURN
  158. '
  159. '
  160. '
  161. :STUFF_FLAG_FILES
  162.  
  163.    flag_list = PPEPATH() + LTRIM(STRING(PCBNODE())," ") + ".FLG"
  164.    IF (EXIST(flag_list)) THEN
  165.      FOPEN 1, flag_list, O_WR, S_DN
  166.    ELSE
  167.      FCREATE 1, flag_list, O_WR, S_DN
  168.    END IF
  169.    start_flag = TRUE
  170.    hold = CHR(13) + "FLAG "
  171.    FOR i = 1 TO next_flag_file-1
  172.      hold = hold + flag_files(i) + " "
  173.      start_flag = FALSE
  174.      IF (LEN(hold) > 230) THEN
  175.        FPUTLN 1, hold
  176.        hold = CHR(13) + "FLAG "
  177.      END IF
  178.    NEXT
  179.    FPUTLN 1, hold
  180.    FCLOSE 1
  181.    RETURN
  182. '
  183. '
  184. '
  185. :FIND_EMPTY_SLOT
  186.  
  187.    filenames_used = 0
  188.    FOR i = 2 TO 25
  189.      IF (DGET(0,DNAME(0,i)) = "            ") THEN
  190.        filenames_used = i-1
  191.        BREAK
  192.      END IF
  193.    NEXT
  194.    RETURN
  195.  
  196. '
  197. '
  198. '
  199. :CHECK_FOR_DUPES
  200.  
  201.    file_dupe = FALSE
  202.    FOR i = 2 TO 25
  203.      IF (   UPPER(TRIM(DGET(0,DNAME(0,i))," ")) = UPPER(TRIM(file_name," "))    ) THEN
  204.        file_dupe = TRUE
  205.        BREAK
  206.      END IF
  207.    NEXT
  208.    RETURN
  209.  
  210. '
  211. '  Subroutine to find/add username in index
  212. '
  213. :FIND_ADD_USER
  214.    '
  215.    '  Get the current users name
  216.    '
  217.    pcb_user_name = UPPER(RTRIM(U_NAME(), " "))
  218.    DSEEK 0, pcb_user_name
  219.    IF (DCHKSTAT(0) = 0) THEN
  220.      GOSUB FIND_EMPTY_SLOT
  221.    ELSE
  222.      '
  223.      ' user not found - add a new record to the database
  224.      '
  225.      SPRINTLN READLINE (tkltext,7)
  226.      i = DRECCOUNT(0) + 1
  227.      DNEW 0
  228.      DLOCKR 0, i
  229.      DBLANK 0
  230.      DPUT 0, "usr_name", pcb_user_name
  231.      DADD 0
  232.      filenames_used = 1
  233.    END IF
  234.    RETURN
  235. '
  236. '  Subroutine to display PCBText Message
  237. '
  238. :DISPLAY_FAILURE
  239.  
  240.    NEWLINE
  241.  
  242.    IF (!INSTR(file_name, "SHORLI")) THEN
  243.      SELECT CASE (pcbtext_number)
  244.        CASE "138"
  245.          DISPFILE PPEPATH() + "pcbt138", GRAPH+LANG
  246.          LOG "Insufficient time remaining to download (@OPTEXT@)", FALSE
  247.        CASE "159"
  248.          DISPFILE PPEPATH() + "pcbt159", GRAPH+LANG
  249.          LOG "(@OPTEXT@) Download bytes left available are @BYTESLEFT@", FALSE
  250.          '(@OPTEXT@) Sorry, @FIRST@, download bytes left available are @BYTESLEFT@
  251.        CASE "555"
  252.          DISPFILE PPEPATH() + "pcbt555", GRAPH+LANG
  253.          LOG "Batch limit reached.  @OPTEXT@ was not added to the batch.", FALSE
  254.        CASE "669"
  255.          DISPFILE PPEPATH() + "pcbt669", GRAPH+LANG
  256.          LOG "Downloading @OPTEXT@ would exceed your file ratio.", FALSE
  257.        CASE "670"
  258.          DISPFILE PPEPATH() + "pcbt670", GRAPH+LANG
  259.          LOG "Downloading @OPTEXT@ would exceed your byte ratio.", FALSE
  260.        CASE "674"
  261.          DISPFILE PPEPATH() + "pcbt674", GRAPH+LANG
  262.          LOG "Downloading @OPTEXT@ would exceed your file limit.", FALSE
  263.        CASE "675"
  264.          DISPFILE PPEPATH() + "pcbt675", GRAPH+LANG
  265.          LOG "Downloading @OPTEXT@ would exceed your byte limit.", FALSE
  266.      END SELECT
  267.    ELSE
  268.      SELECT CASE (pcbtext_number)
  269.        CASE "138"
  270.          PRINTLN "     @X0F*@X0D──────────────────────────────────────────────────────────@X0F*"
  271.          PRINTLN "     @X0EInsufficient time remaining to download @X0A(@X0F@OPTEXT@@X0A)"
  272.          PRINTLN "     @X0F*@X0D──────────────────────────────────────────────────────────@X0F*"
  273.          NEWLINES 2
  274.          WAIT
  275.        CASE "159"
  276.          PRINTLN "     @X0F*@X0D──────────────────────────────────────────────────────────@X0F*"
  277.          PRIN